home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / msdos / 4utils80.zip / DESCRIPT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-17  |  14KB  |  448 lines
  1. UNIT DescriptionHandling;
  2. {$L+,X+,V-}
  3. (* ----------------------------------------------------------------------
  4.    Part of 4DESC - A Simple 4DOS File Description Editor
  5.        and 4FF   - 4DOS File Finder
  6.  
  7.        David Frey,         & Tom Bowden
  8.        Urdorferstrasse 30    1575 Canberra Drive
  9.        8952 Schlieren ZH     Stone Mountain, GA 30088-3629
  10.        Switzerland           USA
  11.  
  12.        Code created using Turbo Pascal 7.0 (c) Borland International 1992
  13.  
  14.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  15.                and change it free of charge, but you may not sell or hire
  16.                this part of 4DESC. The copyright remains in our hands.
  17.  
  18.                If you make any (considerable) changes to the source code,
  19.                please let us know. (send a copy or a listing).
  20.                We would like to see what you have done.
  21.  
  22.                We, David Frey and Tom Bowden, the authors, provide absolutely
  23.                no warranty of any kind. The user of this software takes the
  24.                entire risk of damages, failures, data losses or other
  25.                incidents.
  26.  
  27.    This unit stores/retrieves the file data and descriptions by using
  28.    a TCollection (a Turbo Vision Object).
  29.  
  30.    ----------------------------------------------------------------------- *)
  31.  
  32. INTERFACE USES Objects, Dos, StringDateHandling;
  33.  
  34. CONST MaxDescLen = 200; (* description length of next 4DOS update *)
  35.       DirSize    = '  <DIR> ';
  36.  
  37. TYPE  NameExtStr = STRING[1+8+1+3];
  38.       SizeStr    = STRING[9];
  39.       DescStr    = STRING[MaxDescLen];
  40.       ProgInfo   = STRING;
  41.       SortKeyStr = STRING[14];
  42.  
  43. VAR   DescLong   : BOOLEAN;
  44.       DispLen    : BYTE;
  45.       HelpStr    : DescStr;
  46.       Template   : STRING;
  47.  
  48. TYPE  PFileData  = ^TFileData;
  49.       TFileData  = OBJECT(TObject)
  50.                     IsADir   : BOOLEAN;
  51.                     Name     : PString; (* ^NameExtStr; *)
  52.                     Size     : PString; (* ^SizeStr; *)
  53.                     Date     : PString; (* ^DateStr; *)
  54.                     Time     : PString; (* ^TimeStr; *)
  55.                     ProgInfo : PString; (* ^STRING; *)
  56.                     Desc     : PString; (* ^DescStr; *)
  57.                     SortKey  : PString; (* ^SortKeyStr;
  58.                                            either 0<DirName> for directories,
  59.                                            or     1<Name> for ordinary files *)
  60.  
  61.                     CONSTRUCTOR Init(Search: SearchRec);
  62.                     DESTRUCTOR  Done; VIRTUAL;
  63.  
  64.                     PROCEDURE AssignName(AName: NameExtStr);
  65.                     PROCEDURE AssignDesc(ADesc: DescStr);
  66.                     PROCEDURE AssignProgInfo(AProgInfo: STRING);
  67.  
  68.                     FUNCTION  GetDesc: DescStr;
  69.                     FUNCTION  GetSize: SizeStr;
  70.                     FUNCTION  GetName: NameExtStr;
  71.                     FUNCTION  GetProgInfo: STRING;
  72.  
  73.                     FUNCTION FormatScrollableDescription(off,len: BYTE): STRING;
  74.                    END;
  75.  
  76. CONST ListOK           = 0;
  77.       ListTooManyFiles = 1;
  78.       ListOutOfMem     = 2;
  79.  
  80. TYPE  PFileList  = ^TFileList;
  81.       TFileList  = OBJECT(TSortedCollection)
  82.                     Status      : BYTE;
  83.                     MaxFileLimit: INTEGER;
  84.  
  85.                     CONSTRUCTOR Init(Path: PathStr);
  86.  
  87.                     FUNCTION KeyOf(Item: POINTER): POINTER; VIRTUAL;
  88.                     FUNCTION Compare(key1,key2: POINTER): INTEGER; VIRTUAL;
  89.                    END;
  90.  
  91. VAR   FileList   : PFileList;
  92.  
  93. FUNCTION NILCheck(APtr: POINTER): POINTER;
  94. (* APtr = NIL ? If yes, give a fatal error message and abort. *)
  95.  
  96. IMPLEMENTATION USES Memory, DisplayKeyboardAndCursor, Drivers;
  97.  
  98. (* Allocate a 2KB text buffer for faster reads of DESCRIPT.ION *)
  99. VAR Buffer: ARRAY[1..2048] OF CHAR;
  100.  
  101. {$F+}
  102. FUNCTION HeapFunc(Size: WORD): INTEGER;
  103. (* This is Turbo Pascal Heap Function, which is called whenever the heap
  104.    manager is unable to complete an allocation request.                  *)
  105.  
  106. BEGIN
  107.  HeapFunc := 1;   (* Return NIL if out of heap *)
  108. END;
  109. {$F-}
  110.  
  111. FUNCTION NILCheck(APtr: POINTER): POINTER;
  112. (* Aborts when a NIL pointer has been detected. This prevents
  113.    deferencing a NIL pointer, which could be catastrophic
  114.    (spontaneous rebooting etc.)                               *)
  115.  
  116. BEGIN
  117.  IF APtr = NIL THEN Abort('NIL Pointer detected!')
  118.                ELSE NILCheck := APtr;
  119. END;
  120.  
  121. CONSTRUCTOR TFileData.Init(Search: SearchRec);
  122. (* Constructor method. Constructs a FileData "object" on the heap
  123.    a fills in the appropriate values.                             *)
  124.  
  125. VAR TimeRec  : DateTime;
  126.     s        : STRING;
  127.     c        : CHAR;
  128.  
  129. BEGIN
  130.  TObject.Init;
  131.  
  132.  UnpackTime(Search.Time,TimeRec);
  133.  Name     := NIL;
  134.  Date     := NIL; Date := NewStr(FormDate(TimeRec));
  135.  Time     := NIL; Time := NewStr(FormTime(TimeRec));
  136.  ProgInfo := NIL;
  137.  Desc     := NIL;
  138.  SortKey  := NIL;
  139.  
  140.  IsADir := (Search.Attr AND Directory = Directory);
  141.  IF IsADir THEN
  142.   BEGIN
  143.    s := DirSize;
  144.    c := '0';
  145.    UpString(Search.Name);
  146.   END
  147.  ELSE
  148.   BEGIN
  149.    IF FullSize THEN Str(Search.Size:8,s)
  150.                ELSE s := FormattedLongIntStr(Search.Size DIV 1024,7)+'K';
  151.    c := '1';
  152.   END;
  153.  
  154.  Size    := NewStr(s);
  155.  Name    := NewStr(Search.Name);
  156.  SortKey := NewStr(c + Search.Name);
  157.  (* Force directories ahead of files in sorted display. *)
  158. END;
  159.  
  160. DESTRUCTOR TFileData.Done;
  161. (* Removes a FileData object from the heap. *)
  162.  
  163. BEGIN
  164.  DisposeStr(Date);     Date     := NIL;
  165.  DisposeStr(Time);     Time     := NIL;
  166.  DisposeStr(ProgInfo); ProgInfo := NIL;
  167.  DisposeStr(Desc);     Desc     := NIL;
  168.  DisposeStr(Name);     Name     := NIL;
  169.  DisposeStr(Size);     Size     := NIL;
  170.  DisposeStr(SortKey);  SortKey  := NIL;
  171.  
  172.  TObject.Done;
  173. END;
  174.  
  175. PROCEDURE TFileData.AssignName(AName: NameExtStr);
  176. (* Dynamic version of "Name := AName" *)
  177.  
  178. BEGIN
  179.  IF Name <> NIL THEN
  180.   BEGIN DisposeStr(Name); Name := NIL; END;
  181.  
  182.  Name := NewStr(AName);
  183.  IF (AName <> '') AND (Name = NIL) THEN
  184.   Abort('AssignName: NIL Pointer detected!')
  185. END;
  186.  
  187. PROCEDURE TFileData.AssignDesc(ADesc: DescStr);
  188. (* Dynamic version of "Desc := ADesc" *)
  189.  
  190. BEGIN
  191.  IF Desc <> NIL THEN
  192.   BEGIN DisposeStr(Desc); Desc := NIL; END;
  193.  
  194.  Desc := NewStr(ADesc);
  195.  IF (ADesc <> '') AND (Desc = NIL) THEN
  196.   Abort('AssignDesc: NIL Pointer detected!')
  197. END;
  198.  
  199. PROCEDURE TFileData.AssignProgInfo(AProgInfo: STRING);
  200. (* Dynamic version of "ProgInfo := AProgInfo" *)
  201. BEGIN
  202.  IF ProgInfo <> NIL THEN
  203.   BEGIN DisposeStr(ProgInfo); ProgInfo := NIL; END;
  204.  
  205.  ProgInfo := NewStr(AProgInfo);
  206.  IF (AProgInfo <> '') AND (ProgInfo = NIL) THEN
  207.   Abort('AssignProgInfo: NIL Pointer detected!')
  208. END;
  209.  
  210. FUNCTION TFileData.GetDesc: DescStr;
  211. (* Returns the description of a file *)
  212.  
  213. BEGIN
  214.  IF Desc <> NIL THEN GetDesc := Desc^
  215.                 ELSE GetDesc := '';
  216. END;
  217.  
  218. FUNCTION TFileData.GetSize: SizeStr;
  219. (* Returns the size of a file [as a string] *)
  220.  
  221. BEGIN
  222.  IF Size <> NIL THEN GetSize := Size^
  223.                 ELSE GetSize := '';
  224. END;
  225.  
  226. FUNCTION TFileData.GetName: NameExtStr;
  227. (* Returns the filename *)
  228.  
  229. BEGIN
  230.  IF Name <> NIL THEN GetName := Name^
  231.                 ELSE GetName := '';
  232. END;
  233.  
  234. FUNCTION TFileData.GetProgInfo: STRING;
  235. (* Returns the program information *)
  236.  
  237. BEGIN
  238.  IF ProgInfo <> NIL THEN GetProgInfo := ProgInfo^
  239.                     ELSE GetProgInfo := '';
  240. END;
  241.  
  242. FUNCTION TFileData.FormatScrollableDescription(off,len: BYTE): STRING;
  243. (* Formats a description line. We do not return the full descrption,
  244.    in order to enable scrolling we return only the substring from off
  245.    to off+len.                                                        *)
  246.  
  247. VAR ia : ARRAY[0..4] OF PString;
  248.     s  : STRING;
  249.  
  250. BEGIN
  251.  HelpStr := Copy(GetDesc,off,len); (* HelpStr must be global; @ doesn't
  252.                                       work with local strings
  253.                                       [ I know, it looks clumsy, but this
  254.                                         is a restriction of FormatStr ] *)
  255.  ia[0] := Name;
  256.  ia[1] := Size;
  257.  ia[2] := Date;
  258.  ia[3] := Time;
  259.  ia[4] := @HelpStr;
  260.  
  261.  FormatStr(s,Template,ia);
  262.  FormatScrollableDescription := s;
  263. END;
  264.  
  265. CONSTRUCTOR TFileList.Init(Path: PathStr);
  266. (* Build a list of FileData objects by inserting the directory entries
  267.    in a TSortedCollection.                                             *)
  268.  
  269. CONST CR      = #13;
  270.       LF      = #10;
  271.       EOFMark = #26;
  272.  
  273. VAR DescFileExists : BOOLEAN;
  274.     DescFound      : BOOLEAN;
  275.     DescFile       : TEXT;
  276.     DescLine       : STRING;
  277.     DescName       : NameExtStr;
  278.     DescStart      : BYTE;
  279.     DescEnd        : BYTE;
  280.     Desc           : STRING;
  281.     ProgInfo       : STRING;
  282.     sr             : SearchRec;
  283.     ListEntry      : PFileData;
  284.     mfl            : LONGINT;
  285.     c              : ARRAY[0..1] OF CHAR;
  286.     l              : BYTE;
  287.     Index          : INTEGER;
  288.     Key            : PString;
  289.     SKeyName       : SortKeyStr;
  290.  
  291.  PROCEDURE DescSearch;
  292.  (* Search for a directory name and look whether it has a description or
  293.     not.                                                                *)
  294.  
  295.  BEGIN
  296.    Key := @SKeyName;
  297.    IF Search(Key,Index) THEN
  298.     BEGIN
  299.      DescEnd := Pos(#4,DescLine);
  300.      IF DescEnd = 0 THEN DescEnd := Length(DescLine)+1;
  301.      IF (DescEnd-1) - (DescStart+1) > MaxDescLen THEN DescLong := TRUE;
  302.      Desc := Copy(DescLine,DescStart+1,(DescEnd-DescStart-1));
  303.      StripLeadingSpaces(Desc);
  304.      StripTrailingSpaces(Desc);
  305.      ListEntry := At(Index);
  306.      ListEntry^.AssignDesc(Desc);
  307.      ProgInfo := Copy(DescLine,DescEnd,255);
  308.      ListEntry^.AssignProgInfo(ProgInfo);
  309.     END;
  310.  END;
  311.  
  312.  
  313.  PROCEDURE BeautifyEntries(AnEntry: PFileData); FAR;
  314.  (* Formats the file names to look like
  315.     xxxxx.xxx      (NotLeftJust = TRUE) or
  316.     xxxxx   .xxx   (NotLeftJust = FALSE)                *)
  317.  
  318.  VAR s : NameExtStr;
  319.      p : BYTE;
  320.  
  321.  BEGIN
  322.   IF (AnEntry <> NIL) AND NOT AnEntry^.IsADir THEN
  323.    WITH AnEntry^ DO
  324.     BEGIN
  325.      s := GetName;
  326.      p := Pos('.',s);
  327.      IF p > 0 THEN
  328.       BEGIN
  329.        WHILE NOT NotLeftJust AND (p <> 9) AND (Length(s) < 13) DO
  330.          BEGIN
  331.            System.Insert(' ',s,p);
  332.            p := Pos('.',s);
  333.          END;
  334.        AssignName(s);
  335.       END;
  336.     END; (* with *)
  337.  END;
  338.  
  339. BEGIN
  340.  (* Grab either the maximum size of memory available (if less than 64KB)
  341.     or the maximum collection size.
  342.     This restriction is directly imposed by DOS's segmentation [64KB
  343.     data limit !!. It could be avoided be using a proper Operating System *)
  344.  
  345.  mfl := (MemAvail-2048) DIV SizeOf(POINTER);
  346.  IF mfl > MaxCollectionSize THEN MaxFileLimit := MaxCollectionSize
  347.                             ELSE MaxFileLimit := INTEGER(mfl);
  348.  
  349.  TCollection.Init(MaxFileLimit,0); Status := ListOK;
  350.  
  351.  (* First, collect all files in the current directory. *)
  352.  FindFirst('*.*',ReadOnly+Archive+Directory+BYTE(UseHidden)*Hidden+SysFile, sr);
  353.  WHILE (DosError = 0) AND (Status = ListOK) AND (Count < MaxCollectionSize) DO
  354.   BEGIN
  355.    DownString(sr.Name);
  356.  
  357.    IF MemAvail < SizeOf(TFileData) THEN Status := ListOutOfMem
  358.    ELSE
  359.     BEGIN
  360.      ListEntry := NIL; ListEntry := New(PFileData,Init(sr));
  361.      IF ListEntry <> NIL THEN Insert(ListEntry)
  362.                          ELSE Status := ListOutOfMem;
  363.                               (* Oops, out of mem, New returned a
  364.                                  NIL pointer *)
  365.     END;
  366.  
  367.    FindNext(sr);
  368.   END; (* while *)
  369.  
  370.  IF Count = MaxFileLimit THEN Status := ListTooManyFiles;
  371.  (* Oops, more than MaxFileLimit files reside in this directory. *)
  372.  
  373.  (* Next, open a DESCRIPT.ION file and read out the descriptions. *)
  374.  FindFirst('DESCRIPT.ION',Hidden + Archive,sr);
  375.  DescFileExists := (DosError = 0);
  376.  
  377.  IF DescFileExists THEN
  378.   BEGIN
  379.    {$I-}
  380.    Assign(DescFile,'DESCRIPT.ION');
  381.    SetTextBuf(DescFile,Buffer);
  382.    Reset(DescFile);
  383.    {$I+}
  384.    REPEAT
  385.     DescLine := '';
  386.     c[0] := #0;
  387.     REPEAT
  388.      c[1] := c[0];
  389.      Read(DescFile,c[0]);
  390.      DescLine := DescLine + c[0];
  391.     UNTIL ((c[0] = CR) AND (c[1] = LF)) OR
  392.            (c[1] = CR) OR
  393.            (c[1] = LF) OR
  394.            (c[1] = EOFMark);
  395.     l := Length(DescLine);
  396.     WHILE (DescLine[l] = CR) OR
  397.           (DescLine[l] = LF) OR
  398.           (DescLine[l] = EOFMark) DO
  399.      BEGIN
  400.        System.Delete(DescLine,l,1);
  401.        l := Length(DescLine);
  402.      END;
  403.  
  404.     DescStart := Pos(' ',DescLine);
  405.     IF DescStart = 0 THEN DescStart := Length(DescLine)+1;
  406.     DescName := Copy(DescLine,1,DescStart-1);
  407.     DownString(DescName);
  408.  
  409.     SKeyName := '1' + DescName;
  410.     DescSearch;                   (* File name search *)
  411.  
  412.     UpString(DescName);
  413.     SKeyName := '0' + DescName;
  414.     DescSearch;                   (* Directory name search *)
  415.  
  416.    UNTIL Eof(DescFile);
  417.    {$I-}
  418.    Close(DescFile);
  419.    {$I+}
  420.   END;
  421.  
  422.  ForEach(@BeautifyEntries);
  423. END; (* TFileList.Init *)
  424.  
  425. FUNCTION TFileList.KeyOf(Item: POINTER): POINTER;
  426. (* This function is used by Turbo Vision's TSortedCollection object,
  427.    to determine the key, i.e. which entry is relevant for sorting.  *)
  428.  
  429. BEGIN
  430.  KeyOf := PFileData(Item)^.SortKey;
  431. END; (* TFileList.KeyOf *)
  432.  
  433. FUNCTION TFileList.Compare(key1,key2: POINTER): INTEGER;
  434. (* This function tells the sorted collection how to sort its members.
  435.    (by Name, directories first [this is assured by the SortKey entry) *)
  436.  
  437. BEGIN
  438.  IF PString(key1)^ = PString(key2)^ then Compare := 0
  439.   ELSE
  440.    IF PString(key1)^ < PString(key2)^ then Compare := -1
  441.      ELSE Compare := +1;
  442. END; (* TFileList.Compare *)
  443.  
  444. BEGIN
  445.  HeapError := @HeapFunc;
  446.  FileList  := NIL; (* never leave a Pointer uninitialized ! *)
  447. END.
  448.